perm filename DEPTH.JJM[1,JRA] blob sn#027876 filedate 1973-03-06 generic text, type T, neo UTF8
00100	
00200	
00300	(DEFPROP DEP 
00400	 (LAMBDA(L)
00500	  (PROG (C1 C2)
00600		(SETQ C1 (CDR C))
00700	   A    (SETQ C2 (COND ((NEG (CAR C1)) (CDDAR C1)) (T (CDAR C1))))
00800		(COND ((DEP1 C2 (COPY L)) (RETURN T)))
00900		(SETQ C1 (CDR C1))
01000		(COND (C1 (GO A)))
01100		(RETURN NIL))) 
01200	FEXPR)
01300	
01400	(DEFPROP DEP1 
01500	 (LAMBDA(C L1)
01600	  (PROG (L Z)
01700	   A(SETQ L  (COPY L1))    (COND ((VAR (CAR C)) (GO B)))
01800		(SETQ Z (ASSOC (CAAR C) L))
01900		(COND ((NULL Z) NIL) ((EQ (CDR Z) 1) (RETURN T)) (T (RPLACD Z (SUB1 (CDR Z)))))
02000		(COND ((NULL (CDAR C)) NIL) ((DEP1 (CDAR C)  L) (RETURN T)))
02100	   B    (SETQ C (CDR C))
02200		(COND (C (GO A)))
02300		(RETURN NIL))) 
02400	EXPR)